perm filename FNTSAI.SAI[VIS,HPM] blob
sn#421709 filedate 1979-03-01 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00011 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 ENTRY FNTSEL,CHRDEP,CHRPED,FCACHE,CHRWID,CHR3X2,CHR3Y4,CHR6X4,CHR1X1
C00005 00003 OWN SAFE INTEGER ARRAY FNTAR[0:'177]
C00009 00004 INTERNAL PROCEDURE CHRTRN(INTEGER FNTNUM, CHR REFERENCE INTEGER PIC
C00014 00005 INTERNAL PROCEDURE CHRDEP(INTEGER FNTNUM, CHR REFERENCE INTEGER PIC
C00019 00006 INTERNAL PROCEDURE CHR3X2(INTEGER FNTNUM, CHR REFERENCE INTEGER PIC
C00022 00007 INTERNAL PROCEDURE CHR1X1(INTEGER FNTNUM, CHR REFERENCE INTEGER PIC
C00025 00008 INTERNAL PROCEDURE CHR6X4(INTEGER FNTNUM, CHR REFERENCE INTEGER PIC
C00028 00009 INTERNAL PROCEDURE CHR3Y4(INTEGER FNTNUM, CHR REFERENCE INTEGER PIC
C00031 00010 INTERNAL PROCEDURE CHRPED(INTEGER FNTNUM, CHR REFERENCE INTEGER PIC
C00036 00011 END "FNTSAI"
C00037 ENDMK
C⊗;
ENTRY FNTSEL,CHRDEP,CHRPED,FCACHE,CHRWID,CHR3X2,CHR3Y4,CHR6X4,CHR1X1;
BEGIN "FNTSAI"
REQUIRE "FILHDR.SAI[VIS,HPM]" SOURCE_FILE;
DEFINE PCLN=0; comment index of word in a picture file containing
number of scanlines in the picture;
DEFINE PCWD=1; comment number of words in the picture;
DEFINE PCBY=2; comment number of valid bytes in the picture;
DEFINE PCBYA=3; comment no. of bytes including the nulls at the end of lines;
DEFINE LNWD=4; comment no. of words per scanline;
DEFINE LNBY=5; comment no. of valid bytes per scanline;
DEFINE LNBYA=6; comment no. of bytes per scanline, including the nulls;
DEFINE WDBY=7; comment no. of bytes per word;
DEFINE WDBI=8; comment no. of bits containing data in a word;
DEFINE BYBI=9; comment no. of bits per byte;
DEFINE BMAX=10; comment maximum value of a byte;
DEFINE BPTAB=11; comment address of second entry in byte pntr. table;
DEFINE LINTAB=12; comment actual address of the first entry in the row table;
OWN SAFE INTEGER ARRAY FNTAR[0:'177];
OWN SAFE STRING ARRAY FNTNAM[0:'177];
OWN STRING FILNM;
PRELOAD_WITH 0,0,0,0;
OWN SAFE INTEGER ARRAY CBUF[0:3];
PRELOAD_WITH -1,-1;
OWN SAFE INTEGER ARRAY CHO[1:2];
EXTERNAL PROCEDURE ADDEL(REFERENCE INTEGER PIC; INTEGER I,J,VAL);
EXTERNAL PROCEDURE PUTEL(REFERENCE INTEGER PIC; INTEGER I,J,VAL);
DEFINE FNTHIG='201;
DEFINE FNTBAS='203;
INTERNAL INTEGER PROCEDURE FNTSEL(INTEGER FNTNUM; STRING FILSPEC;
REFERENCE INTEGER FNTHEAD);
BEGIN "FNTSEL"
INTEGER ICHAN,FOO,IFLAG;
PRSFIL(FILSPEC);
FNTNAM[FNTNUM]←DEVPRS&":"&FILPRS;
IF CHO[2]≠-1 THEN RELEASE(CHO[2]);
CHO[2]←-1;
CHO[1]←-1;
FNTAR[FNTNUM]←LOCATION(FNTHEAD);
ICHAN←GETCHAN;
IFLAG←TRUE;
OPEN(ICHAN,DEVPRS,'10,19,0,FOO,FOO,IFLAG);
LOOKUP(ICHAN,FILPRS,IFLAG);
IF IFLAG THEN BEGIN RELEASE(ICHAN); RETURN(-1); END;
ARRYIN(ICHAN,MEMORY[LOCATION(FNTHEAD)+0],'204);
RELEASE(ICHAN);
RETURN(MEMORY[LOCATION(FNTHEAD)+FNTHIG]); comment return height of font;
END "FNTSEL";
INTERNAL INTEGER PROCEDURE CHRWID(INTEGER FNTNUM, CHR);
BEGIN
INTEGER ICHAN,FOO,POS,I,J,RASW;
POS←MEMORY[FNTAR[FNTNUM]+CHR] LAND '777777;
POS←(POS LSH 18) ASH -18;
IF POS>0 THEN
BEGIN "READA"
IF CHO[1]≠FNTNUM THEN
BEGIN
IF CHO[2]≠-1 THEN RELEASE(CHO[2]);
PRSFIL(FNTNAM[FNTNUM]);
CHO[2]←GETCHAN;
FOO←1;
OPEN(CHO[2],DEVPRS,'10,19,0,FOO,FOO,FOO);
LOOKUP(CHO[2],FILPRS,FOO);
CHO[1]←FNTNUM;
END;
USETI(CHO[2],POS%128 + 1);
FOR I←1 STEP 1 UNTIL (POS MOD 128) DO WORDIN(CHO[2]);
RASW←WORDIN(CHO[2]) LSH -27;
END "READA"
ELSE
BEGIN "BUFA"
POS←-POS;
RASW←MEMORY[POS] LSH -27;
END "BUFA";
IF RASW=0 THEN RASW←MEMORY[FNTAR[FNTNUM]+CHR] LSH -18;
RETURN(RASW);
END;
INTERNAL PROCEDURE FCACHE(REFERENCE INTEGER CHE; INTEGER BFSZ);
BEGIN
CBUF[2]←CBUF[0]←LOCATION(CHE);
CBUF[3]←CBUF[1]←BFSZ;
END;
INTERNAL PROCEDURE CHRTRN(INTEGER FNTNUM, CHR; REFERENCE INTEGER PIC;
INTEGER YLO,XLO; REAL XS,YS,DXS,DYS);
comment deposits font character at x 1 compression with lower
left corner at XLO,YLO and arbitrary linear transformation
defined by XS,YS,DXS,DYS. Can rotate and italicize text;
BEGIN "CHRTRN"
INTEGER ICHAN,FOO,POS,I,J,RASW, YDIS,XDIS;
YDIS←MEMORY[FNTAR[FNTNUM]+FNTBAS];
comment YLO←YLO-MEMORY[FNTAR[FNTNUM]+FNTBAS];
IF (MEMORY[FNTAR[FNTNUM]+CHR]) LAND '777777≠0 THEN
BEGIN "REAL"
POS←MEMORY[FNTAR[FNTNUM]+CHR] LAND '777777;
POS←(POS LSH 18) ASH -18;
IF POS>0 THEN
BEGIN "READA"
IF CHO[1]≠FNTNUM THEN
BEGIN
IF CHO[2]≠-1 THEN RELEASE(CHO[2]);
PRSFIL(FNTNAM[FNTNUM]);
CHO[2]←GETCHAN;
FOO←1;
OPEN(CHO[2],DEVPRS,'10,19,0,FOO,FOO,FOO);
LOOKUP(CHO[2],FILPRS,FOO);
CHO[1]←FNTNUM;
END;
USETI(CHO[2],POS%128 + 1);
FOR I←1 STEP 1 UNTIL (POS MOD 128) DO WORDIN(CHO[2]);
RASW←WORDIN(CHO[2]);
IF (RASW LSH -27)=0 THEN
RASW←RASW LOR ((MEMORY[FNTAR[FNTNUM]+CHR] LSH -18) LSH 27);
BEGIN "READ"
INTEGER NROW,PTQ;
INTEGER ARRAY CHAR[0:(RASW LAND '777777)-2];
ARRYIN(CHO[2],CHAR[0],(RASW LAND '777777)-1);
IF CBUF[1]≥4*(RASW LAND '777777) THEN
BEGIN
MEMORY[CBUF[0]]←RASW;
ARRBLT(MEMORY[CBUF[0]+1],CHAR[0],(RASW LAND '777777)-1);
MEMORY[FNTAR[FNTNUM]+CHR]←
(MEMORY[FNTAR[FNTNUM]+CHR] LAND '777777000000) LOR
((-CBUF[0]) LAND '777777);
CBUF[0]←CBUF[0]+(RASW LAND '777777);
CBUF[1]←CBUF[1]-(RASW LAND '777777);
END
ELSE
OUTSTR("!");
RASW←RASW LSH -27;
IF RASW=0 THEN RASW←MEMORY[FNTAR[FNTNUM]+CHR] LSH -18;
comment XLO←XLO-(CHAR[0] ASH -27);
comment YLO←YLO+((CHAR[0] LSH 9) LSH -27);
XDIS←-(CHAR[0] ASH -27);
YDIS←YDIS-((CHAR[0] LSH 9) LSH -27);
NROW←CHAR[0] LAND '777777;
IF NROW*RASW>0 THEN PTQ←POINT(1,CHAR[1],-1);
FOR I←YDIS STEP -1 UNTIL YDIS-NROW+1 DO
BEGIN "PACK"
FOR J←XDIS STEP 1 UNTIL XDIS+RASW-1 DO IF ILDB(PTQ) THEN
PUTEL(PIC,YLO-I*YS-J*DYS,XLO+J*XS+I*DXS,1);
IF (PTQ LSH -30) < RASW THEN PTQ←PTQ LAND '7777777777;
END "PACK";
END "READ";
END "READA"
ELSE
BEGIN "BUFA"
POS←-POS;
RASW←MEMORY[POS];
BEGIN "READ"
INTEGER NROW,PTQ;
RASW←RASW LSH -27;
IF RASW=0 THEN RASW←MEMORY[FNTAR[FNTNUM]+CHR] LSH -18;
comment XLO←XLO-(MEMORY[POS+1] ASH -27);
comment YLO←YLO+((MEMORY[POS+1] LSH 9) LSH -27);
XDIS←-(MEMORY[POS+1] ASH -27);
YDIS←YDIS-((MEMORY[POS+1] LSH 9) LSH -27);
NROW←MEMORY[POS+1] LAND '777777;
IF NROW*RASW>0 THEN PTQ←POINT(1,MEMORY[POS+2],-1);
FOR I←YDIS STEP -1 UNTIL YDIS-NROW+1 DO
BEGIN "PACK"
FOR J←XDIS STEP 1 UNTIL XDIS+RASW-1 DO IF ILDB(PTQ) THEN
PUTEL(PIC,YLO-I*YS-J*DYS,XLO+J*XS+I*DXS,1);
IF (PTQ LSH -30) < RASW THEN PTQ←PTQ LAND '7777777777;
END "PACK";
END "READ";
END "BUFA";
END "REAL";
END "CHRTRN";
INTERNAL PROCEDURE CHRDEP(INTEGER FNTNUM, CHR; REFERENCE INTEGER PIC;
INTEGER YLO,XLO, YCOMP(1),XCOMP(1));
BEGIN "CHRDEP"
INTEGER ICHAN,FOO,POS,I,J,RASW;
YLO←YLO-MEMORY[FNTAR[FNTNUM]+FNTBAS];
IF (MEMORY[FNTAR[FNTNUM]+CHR]) LAND '777777≠0 ∧
YLO+MEMORY[FNTAR[FNTNUM]+FNTHIG]≥0 ∧ YLO≤MEMORY[LOCATION(PIC)+PCLN]*YCOMP THEN
BEGIN "REAL"
POS←MEMORY[FNTAR[FNTNUM]+CHR] LAND '777777;
POS←(POS LSH 18) ASH -18;
IF POS>0 THEN
BEGIN "READA"
IF CHO[1]≠FNTNUM THEN
BEGIN
IF CHO[2]≠-1 THEN RELEASE(CHO[2]);
PRSFIL(FNTNAM[FNTNUM]);
CHO[2]←GETCHAN;
FOO←1;
OPEN(CHO[2],DEVPRS,'10,19,0,FOO,FOO,FOO);
LOOKUP(CHO[2],FILPRS,FOO);
CHO[1]←FNTNUM;
END;
USETI(CHO[2],POS%128 + 1);
FOR I←1 STEP 1 UNTIL (POS MOD 128) DO WORDIN(CHO[2]);
RASW←WORDIN(CHO[2]);
IF (RASW LSH -27)=0 THEN
RASW←RASW LOR ((MEMORY[FNTAR[FNTNUM]+CHR] LSH -18) LSH 27);
BEGIN "READ"
INTEGER NROW,PTQ;
INTEGER ARRAY CHAR[0:(RASW LAND '777777)-2];
ARRYIN(CHO[2],CHAR[0],(RASW LAND '777777)-1);
IF CBUF[1]≥4*(RASW LAND '777777) THEN
BEGIN
MEMORY[CBUF[0]]←RASW;
ARRBLT(MEMORY[CBUF[0]+1],CHAR[0],(RASW LAND '777777)-1);
MEMORY[FNTAR[FNTNUM]+CHR]←
(MEMORY[FNTAR[FNTNUM]+CHR] LAND '777777000000) LOR
((-CBUF[0]) LAND '777777);
CBUF[0]←CBUF[0]+(RASW LAND '777777);
CBUF[1]←CBUF[1]-(RASW LAND '777777);
END
ELSE
OUTSTR("!");
RASW←RASW LSH -27;
IF RASW=0 THEN RASW←MEMORY[FNTAR[FNTNUM]+CHR] LSH -18;
XLO←XLO-(CHAR[0] ASH -27);
YLO←YLO+((CHAR[0] LSH 9) LSH -27);
NROW←CHAR[0] LAND '777777;
IF NROW*RASW>0 THEN PTQ←POINT(1,CHAR[1],-1);
FOR I←0 STEP 1 UNTIL NROW-1 DO
BEGIN "PACK"
INTEGER YPA;
YPA←(YLO+I)%YCOMP;
FOR J←0 STEP 1 UNTIL RASW-1 DO IF ILDB(PTQ) THEN
ADDEL(PIC,YPA,(XLO+J)%XCOMP,1);
IF (PTQ LSH -30) < RASW THEN PTQ←PTQ LAND '7777777777;
END "PACK";
END "READ";
END "READA"
ELSE
BEGIN "BUFA"
POS←-POS;
RASW←MEMORY[POS];
BEGIN "READ"
INTEGER NROW,PTQ;
RASW←RASW LSH -27;
IF RASW=0 THEN RASW←MEMORY[FNTAR[FNTNUM]+CHR] LSH -18;
XLO←XLO-(MEMORY[POS+1] ASH -27);
YLO←YLO+((MEMORY[POS+1] LSH 9) LSH -27);
NROW←MEMORY[POS+1] LAND '777777;
IF NROW*RASW>0 THEN PTQ←POINT(1,MEMORY[POS+2],-1);
FOR I←0 STEP 1 UNTIL NROW-1 DO
BEGIN "PACK"
INTEGER YPA;
YPA←(YLO+I)%YCOMP;
FOR J←0 STEP 1 UNTIL RASW-1 DO IF ILDB(PTQ) THEN
ADDEL(PIC,YPA,(XLO+J)%XCOMP,1);
IF (PTQ LSH -30) < RASW THEN PTQ←PTQ LAND '7777777777;
END "PACK";
END "READ";
END "BUFA";
END "REAL";
END "CHRDEP";
INTERNAL PROCEDURE CHR3X2(INTEGER FNTNUM, CHR; REFERENCE INTEGER PIC;
INTEGER YLO,XLO);
BEGIN "CHR3X2"
EXTERNAL PROCEDURE L3X2(REFERENCE INTEGER PIC; INTEGER YLO,XLO;
REFERENCE INTEGER CHAR);
INTEGER ICHAN,FOO,POS,I,J,RASW;
YLO←YLO-MEMORY[FNTAR[FNTNUM]+FNTBAS];
IF (MEMORY[FNTAR[FNTNUM]+CHR]) LAND '777777≠0 ∧
YLO≥0 ∧ YLO<MEMORY[LOCATION(PIC)+PCLN]*2 THEN
BEGIN "REAL"
POS←MEMORY[FNTAR[FNTNUM]+CHR] LAND '777777;
POS←(POS LSH 18) ASH -18;
IF POS>0 THEN
BEGIN "READA"
IF CHO[1]≠FNTNUM THEN
BEGIN
IF CHO[2]≠-1 THEN RELEASE(CHO[2]);
PRSFIL(FNTNAM[FNTNUM]);
CHO[2]←GETCHAN;
FOO←1;
OPEN(CHO[2],DEVPRS,'10,19,0,FOO,FOO,FOO);
LOOKUP(CHO[2],FILPRS,FOO);
CHO[1]←FNTNUM;
END;
USETI(CHO[2],POS%128 + 1);
FOR I←(POS MOD 128) STEP -1 UNTIL 1 DO WORDIN(CHO[2]);
RASW←WORDIN(CHO[2]);
IF (RASW LSH -27)=0 THEN
RASW←RASW LOR ((MEMORY[FNTAR[FNTNUM]+CHR] LSH -18) LSH 27);
BEGIN "READ"
SAFE INTEGER ARRAY CHAR[-1:(RASW LAND '777777)-2];
CHAR[-1]←RASW;
ARRYIN(CHO[2],CHAR[0],(RASW LAND '777777)-1);
IF CBUF[1]≥4*(RASW LAND '777777) THEN
BEGIN
MEMORY[CBUF[0]]←RASW;
ARRBLT(MEMORY[CBUF[0]+1],CHAR[0],(RASW LAND '777777)-1);
MEMORY[FNTAR[FNTNUM]+CHR]←
(MEMORY[FNTAR[FNTNUM]+CHR] LAND '777777000000) LOR
((-CBUF[0]) LAND '777777);
CBUF[0]←CBUF[0]+(RASW LAND '777777);
CBUF[1]←CBUF[1]-(RASW LAND '777777);
END
ELSE
OUTSTR("!");
L3X2(PIC,
YLO+((CHAR[0] LSH 9) LSH -27),XLO-(CHAR[0] ASH -27),
CHAR[-1]);
END "READ";
END "READA"
ELSE
L3X2(PIC,
YLO+((MEMORY[1-POS] LSH 9) LSH -27),XLO-(MEMORY[1-POS] ASH -27),
MEMORY[-POS]);
END "REAL";
END "CHR3X2";
INTERNAL PROCEDURE CHR1X1(INTEGER FNTNUM, CHR; REFERENCE INTEGER PIC;
INTEGER YLO,XLO);
BEGIN "CHR1X1"
EXTERNAL PROCEDURE L1X1(REFERENCE INTEGER PIC; INTEGER YLO,XLO;
REFERENCE INTEGER CHAR);
INTEGER ICHAN,FOO,POS,I,J,RASW;
YLO←YLO-MEMORY[FNTAR[FNTNUM]+FNTBAS];
IF (MEMORY[FNTAR[FNTNUM]+CHR]) LAND '777777≠0 ∧
YLO≥0 ∧ YLO<MEMORY[LOCATION(PIC)+PCLN] THEN
BEGIN "REAL"
POS←MEMORY[FNTAR[FNTNUM]+CHR] LAND '777777;
POS←(POS LSH 18) ASH -18;
IF POS>0 THEN
BEGIN "READA"
IF CHO[1]≠FNTNUM THEN
BEGIN
IF CHO[2]≠-1 THEN RELEASE(CHO[2]);
PRSFIL(FNTNAM[FNTNUM]);
CHO[2]←GETCHAN;
FOO←1;
OPEN(CHO[2],DEVPRS,'10,19,0,FOO,FOO,FOO);
LOOKUP(CHO[2],FILPRS,FOO);
CHO[1]←FNTNUM;
END;
USETI(CHO[2],POS%128 + 1);
FOR I←(POS MOD 128) STEP -1 UNTIL 1 DO WORDIN(CHO[2]);
RASW←WORDIN(CHO[2]);
IF (RASW LSH -27)=0 THEN
RASW←RASW LOR ((MEMORY[FNTAR[FNTNUM]+CHR] LSH -18) LSH 27);
BEGIN "READ"
SAFE INTEGER ARRAY CHAR[-1:(RASW LAND '777777)-2];
CHAR[-1]←RASW;
ARRYIN(CHO[2],CHAR[0],(RASW LAND '777777)-1);
IF CBUF[1]≥4*(RASW LAND '777777) THEN
BEGIN
MEMORY[CBUF[0]]←RASW;
ARRBLT(MEMORY[CBUF[0]+1],CHAR[0],(RASW LAND '777777)-1);
MEMORY[FNTAR[FNTNUM]+CHR]←
(MEMORY[FNTAR[FNTNUM]+CHR] LAND '777777000000) LOR
((-CBUF[0]) LAND '777777);
CBUF[0]←CBUF[0]+(RASW LAND '777777);
CBUF[1]←CBUF[1]-(RASW LAND '777777);
END
ELSE
OUTSTR("!");
L1X1(PIC,
YLO+((CHAR[0] LSH 9) LSH -27),XLO-(CHAR[0] ASH -27),
CHAR[-1]);
END "READ";
END "READA"
ELSE
L1X1(PIC,
YLO+((MEMORY[1-POS] LSH 9) LSH -27),XLO-(MEMORY[1-POS] ASH -27),
MEMORY[-POS]);
END "REAL";
END "CHR1X1";
INTERNAL PROCEDURE CHR6X4(INTEGER FNTNUM, CHR; REFERENCE INTEGER PIC;
INTEGER YLO,XLO);
BEGIN "CHR6X4"
EXTERNAL PROCEDURE L6X4(REFERENCE INTEGER PIC; INTEGER YLO,XLO;
REFERENCE INTEGER CHAR);
INTEGER ICHAN,FOO,POS,I,J,RASW;
YLO←YLO-MEMORY[FNTAR[FNTNUM]+FNTBAS];
IF (MEMORY[FNTAR[FNTNUM]+CHR]) LAND '777777≠0 ∧
YLO≥0 ∧ YLO<MEMORY[LOCATION(PIC)+PCLN]*4 THEN
BEGIN "REAL"
POS←MEMORY[FNTAR[FNTNUM]+CHR] LAND '777777;
POS←(POS LSH 18) ASH -18;
IF POS>0 THEN
BEGIN "READA"
IF CHO[1]≠FNTNUM THEN
BEGIN
IF CHO[2]≠-1 THEN RELEASE(CHO[2]);
PRSFIL(FNTNAM[FNTNUM]);
CHO[2]←GETCHAN;
FOO←1;
OPEN(CHO[2],DEVPRS,'10,19,0,FOO,FOO,FOO);
LOOKUP(CHO[2],FILPRS,FOO);
CHO[1]←FNTNUM;
END;
USETI(CHO[2],POS%128 + 1);
FOR I←1 STEP 1 UNTIL (POS MOD 128) DO WORDIN(CHO[2]);
RASW←WORDIN(CHO[2]);
IF (RASW LSH -27)=0 THEN
RASW←RASW LOR ((MEMORY[FNTAR[FNTNUM]+CHR] LSH -18) LSH 27);
BEGIN "READ"
SAFE INTEGER ARRAY CHAR[-1:(RASW LAND '777777)-2];
CHAR[-1]←RASW;
ARRYIN(CHO[2],CHAR[0],(RASW LAND '777777)-1);
IF CBUF[1]≥4*(RASW LAND '777777) THEN
BEGIN
MEMORY[CBUF[0]]←RASW;
ARRBLT(MEMORY[CBUF[0]+1],CHAR[0],(RASW LAND '777777)-1);
MEMORY[FNTAR[FNTNUM]+CHR]←
(MEMORY[FNTAR[FNTNUM]+CHR] LAND '777777000000) LOR
((-CBUF[0]) LAND '777777);
CBUF[0]←CBUF[0]+(RASW LAND '777777);
CBUF[1]←CBUF[1]-(RASW LAND '777777);
END
ELSE
OUTSTR("!");
L6X4(PIC,
YLO+((CHAR[0] LSH 9) LSH -27),XLO-(CHAR[0] ASH -27),
CHAR[-1]);
END "READ";
END "READA"
ELSE
L6X4(PIC,
YLO+((MEMORY[1-POS] LSH 9) LSH -27),XLO-(MEMORY[1-POS] ASH -27),
MEMORY[-POS]);
END "REAL";
END "CHR6X4";
INTERNAL PROCEDURE CHR3Y4(INTEGER FNTNUM, CHR; REFERENCE INTEGER PIC;
INTEGER YLO,XLO);
BEGIN "CHR3Y4"
EXTERNAL PROCEDURE L3Y4(REFERENCE INTEGER PIC; INTEGER YLO,XLO;
REFERENCE INTEGER CHAR);
INTEGER ICHAN,FOO,POS,I,J,RASW;
YLO←YLO-MEMORY[FNTAR[FNTNUM]+FNTBAS];
IF (MEMORY[FNTAR[FNTNUM]+CHR]) LAND '777777≠0 ∧
YLO≥0 ∧ YLO<MEMORY[LOCATION(PIC)+LNBY]*4 THEN
BEGIN "REAL"
POS←MEMORY[FNTAR[FNTNUM]+CHR] LAND '777777;
POS←(POS LSH 18) ASH -18;
IF POS>0 THEN
BEGIN "READA"
IF CHO[1]≠FNTNUM THEN
BEGIN
IF CHO[2]≠-1 THEN RELEASE(CHO[2]);
PRSFIL(FNTNAM[FNTNUM]);
CHO[2]←GETCHAN;
FOO←1;
OPEN(CHO[2],DEVPRS,'10,19,0,FOO,FOO,FOO);
LOOKUP(CHO[2],FILPRS,FOO);
CHO[1]←FNTNUM;
END;
USETI(CHO[2],POS%128 + 1);
FOR I←1 STEP 1 UNTIL (POS MOD 128) DO WORDIN(CHO[2]);
RASW←WORDIN(CHO[2]);
IF (RASW LSH -27)=0 THEN
RASW←RASW LOR ((MEMORY[FNTAR[FNTNUM]+CHR] LSH -18) LSH 27);
BEGIN "READ"
SAFE INTEGER ARRAY CHAR[-1:(RASW LAND '777777)-2];
CHAR[-1]←RASW;
ARRYIN(CHO[2],CHAR[0],(RASW LAND '777777)-1);
IF CBUF[1]≥4*(RASW LAND '777777) THEN
BEGIN
MEMORY[CBUF[0]]←RASW;
ARRBLT(MEMORY[CBUF[0]+1],CHAR[0],(RASW LAND '777777)-1);
MEMORY[FNTAR[FNTNUM]+CHR]←
(MEMORY[FNTAR[FNTNUM]+CHR] LAND '777777000000) LOR
((-CBUF[0]) LAND '777777);
CBUF[0]←CBUF[0]+(RASW LAND '777777);
CBUF[1]←CBUF[1]-(RASW LAND '777777);
END
ELSE
OUTSTR("!");
L3Y4(PIC,
YLO+((CHAR[0] LSH 9) LSH -27),XLO-(CHAR[0] ASH -27),
CHAR[-1]);
END "READ";
END "READA"
ELSE
L3Y4(PIC,
YLO+((MEMORY[1-POS] LSH 9) LSH -27),XLO-(MEMORY[1-POS] ASH -27),
MEMORY[-POS]);
END "REAL";
END "CHR3Y4";
INTERNAL PROCEDURE CHRPED(INTEGER FNTNUM, CHR; REFERENCE INTEGER PIC;
INTEGER YLO,XLO, YCOMP(1),XCOMP(1));
BEGIN "CHRPED"
INTEGER ICHAN,FOO,POS,I,J,RASW,PHI;
PHI←MEMORY[LOCATION(PIC)+PCLN];
YLO←YLO-MEMORY[FNTAR[FNTNUM]+FNTBAS];
IF (MEMORY[FNTAR[FNTNUM]+CHR]) LAND '777777≠0 ∧
YLO+MEMORY[FNTAR[FNTNUM]+FNTHIG]≥0 ∧ YLO≤MEMORY[LOCATION(PIC)+LNBY]*YCOMP THEN
BEGIN "REAL"
POS←MEMORY[FNTAR[FNTNUM]+CHR] LAND '777777;
POS←(POS LSH 18) ASH -18;
IF POS>0 THEN
BEGIN "READA"
IF CHO[1]≠FNTNUM THEN
BEGIN
IF CHO[2]≠-1 THEN RELEASE(CHO[2]);
PRSFIL(FNTNAM[FNTNUM]);
CHO[2]←GETCHAN;
FOO←1;
OPEN(CHO[2],DEVPRS,'10,19,0,FOO,FOO,FOO);
LOOKUP(CHO[2],FILPRS,FOO);
CHO[1]←FNTNUM;
END;
USETI(CHO[2],POS%128 + 1);
FOR I←1 STEP 1 UNTIL (POS MOD 128) DO WORDIN(CHO[2]);
RASW←WORDIN(CHO[2]);
IF (RASW LSH -27)=0 THEN
RASW←RASW LOR ((MEMORY[FNTAR[FNTNUM]+CHR] LSH -18) LSH 27);
BEGIN "READ"
INTEGER NROW,PTQ;
INTEGER ARRAY CHAR[0:(RASW LAND '777777)-2];
ARRYIN(CHO[2],CHAR[0],(RASW LAND '777777)-1);
IF CBUF[1]≥4*(RASW LAND '777777) THEN
BEGIN
MEMORY[CBUF[0]]←RASW;
ARRBLT(MEMORY[CBUF[0]+1],CHAR[0],(RASW LAND '777777)-1);
MEMORY[FNTAR[FNTNUM]+CHR]←
(MEMORY[FNTAR[FNTNUM]+CHR] LAND '777777000000) LOR
((-CBUF[0]) LAND '777777);
CBUF[0]←CBUF[0]+(RASW LAND '777777);
CBUF[1]←CBUF[1]-(RASW LAND '777777);
END
ELSE
OUTSTR("!");
RASW←RASW LSH -27;
IF RASW=0 THEN RASW←MEMORY[FNTAR[FNTNUM]+CHR] LSH -18;
XLO←XLO-(CHAR[0] ASH -27);
YLO←YLO+((CHAR[0] LSH 9) LSH -27);
NROW←CHAR[0] LAND '777777;
IF NROW*RASW>0 THEN PTQ←POINT(1,CHAR[1],-1);
FOR I←0 STEP 1 UNTIL NROW-1 DO
BEGIN "PACK"
INTEGER YPA;
YPA←(YLO+I)%YCOMP;
FOR J←0 STEP 1 UNTIL RASW-1 DO IF ILDB(PTQ) THEN
ADDEL(PIC,PHI-(XLO+J)%XCOMP,YPA,1);
IF (PTQ LSH -30) < RASW THEN PTQ←PTQ LAND '7777777777;
END "PACK";
END "READ";
END "READA"
ELSE
BEGIN "BUFA"
POS←-POS;
RASW←MEMORY[POS];
BEGIN "READ"
INTEGER NROW,PTQ;
RASW←RASW LSH -27;
IF RASW=0 THEN RASW←MEMORY[FNTAR[FNTNUM]+CHR] LSH -18;
XLO←XLO-(MEMORY[POS+1] ASH -27);
YLO←YLO+((MEMORY[POS+1] LSH 9) LSH -27);
NROW←MEMORY[POS+1] LAND '777777;
IF NROW*RASW>0 THEN PTQ←POINT(1,MEMORY[POS+2],-1);
FOR I←0 STEP 1 UNTIL NROW-1 DO
BEGIN "PACK"
INTEGER YPA;
YPA←(YLO+I)%YCOMP;
FOR J←0 STEP 1 UNTIL RASW-1 DO IF ILDB(PTQ) THEN
ADDEL(PIC,PHI-(XLO+J)%XCOMP,YPA,1);
IF (PTQ LSH -30) < RASW THEN PTQ←PTQ LAND '7777777777;
END "PACK";
END "READ";
END "BUFA";
END "REAL";
END "CHRPED";
END "FNTSAI";